home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpcsrc.lha / fpc / compiler / ag386int.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  31KB  |  797 lines
  1. {
  2.     $Id: ag386int.pas,v 1.1.1.1.2.2 1998/05/25 23:00:22 carl Exp $
  3.     Copyright (c) 1996,97 by Florian Klaempfl
  4.  
  5.     This unit implements an asmoutput class for Intel syntax with Intel i386+
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************
  22. }
  23. {$R-}
  24. unit ag386int;
  25.  
  26.     interface
  27.  
  28.     uses aasm,assemble;
  29.  
  30.     type
  31.       pi386intasmlist=^ti386intasmlist;
  32.       ti386intasmlist = object(tasmlist)
  33.         procedure WriteTree(p:paasmoutput);virtual;
  34.         procedure WriteAsmList;virtual;
  35.       end;
  36.  
  37.   implementation
  38.  
  39.     uses
  40.       dos,globals,systems,cobjects,i386,
  41.       strings,files,verbose
  42. {$ifdef GDB}
  43.       ,gdb
  44. {$endif GDB}
  45.       ;
  46.  
  47.     const
  48.       line_length = 70;
  49.  
  50.       extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
  51.              ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
  52.               'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
  53.  
  54.     function getreferencestring(const ref : treference) : string;
  55.     var
  56.       s     : string;
  57.       first : boolean;
  58.     begin
  59.       if ref.isintvalue then
  60.        s:= tostr(ref.offset)
  61.       else
  62. {$ifdef ver0_6}
  63.        begin
  64.       first:=true;
  65.       { have we a segment prefix ? }
  66.       if ref.segment<>R_DEFAULT_SEG then
  67.       begin
  68.         if current_module^.output_format in [of_nasm,of_obj] then
  69.           s:='['+_reg2str[ref.segment]+':'
  70.         else
  71.           s:=_reg2str[ref.segment]+':[';
  72.       end
  73.       else s:='[';
  74.  
  75.       if assigned(ref.symbol) then
  76.         begin
  77.            s:=s+ref.symbol^;
  78.            first:=false;
  79.         end;
  80.       if (ref.base<>R_NO) then
  81.         begin
  82.            if not(first) then
  83.              s:=s+'+'
  84.            else
  85.              first:=false;
  86.            s:=s+_reg2str[ref.base];
  87.         end;
  88.       if (ref.index<>R_NO) then
  89.         begin
  90.            if not(first) then
  91.              s:=s+'+'
  92.            else
  93.              first:=false;
  94.            s:=s+_reg2str[ref.index];
  95.            if ref.scalefactor<>0 then
  96.              s:=s+'*'+tostr(ref.scalefactor);
  97.         end;
  98.       if ref.offset<0 then
  99.         s:=s+tostr(ref.offset)
  100.       else if (ref.offset>0) then
  101.         s:=s+'+'+tostr(ref.offset);
  102.       s:=s+']';
  103.         end;
  104. {$else}
  105.       with ref do
  106.         begin
  107.           first:=true;
  108.           if ref.segment<>R_DEFAULT_SEG then
  109.            begin
  110.              if current_module^.output_format in [of_nasm,of_obj] then
  111.               s:='['+int_reg2str[segment]+':'
  112.              else
  113.               s:=int_reg2str[segment]+':[';
  114.            end
  115.           else
  116.            s:='[';
  117.  
  118.          if assigned(symbol) then
  119.           begin
  120.             s:=s+symbol^;
  121.             first:=false;
  122.           end;
  123.          if (base<>R_NO) then
  124.           begin
  125.             if not(first) then
  126.              s:=s+'+'
  127.             else
  128.              first:=false;
  129.              s:=s+int_reg2str[base];
  130.           end;
  131.          if (index<>R_NO) then
  132.            begin
  133.              if not(first) then
  134.                s:=s+'+'
  135.              else
  136.                first:=false;
  137.              s:=s+int_reg2str[index];
  138.              if scalefactor<>0 then
  139.                s:=s+'*'+tostr(scalefactor);
  140.            end;
  141.          if offset<0 then
  142.            s:=s+tostr(offset)
  143.          else if (offset>0) then
  144.            s:=s+'+'+tostr(offset);
  145.          s:=s+']';
  146.         end;
  147. {$endif}
  148.        getreferencestring:=s;
  149.      end;
  150.  
  151.     function getopstr(t : byte;o : pointer;s : topsize; _operator: tasmop;dest : boolean) : string;
  152.  
  153.       var
  154.     hs : string;
  155.  
  156.       begin
  157.     case t of
  158.        top_reg : { a floating point register can be only a register operand }
  159.             if current_module^.output_format in [of_nasm,of_obj] then
  160.                getopstr:=int_nasmreg2str[tregister(o)]
  161.             else
  162.                getopstr:=int_reg2str[tregister(o)];
  163.        top_const,
  164.        top_ref : begin
  165.                   if t=top_const then
  166.                     hs := tostr(longint(o))
  167.                   else
  168.                     hs:=getreferencestring(preference(o)^);
  169.                   if current_module^.output_format in [of_nasm,of_obj] then
  170.                     if (_operator = A_LEA) or (_operator = A_LGS)
  171.                     or (_operator = A_LSS) or (_operator = A_LFS)
  172.                     or (_operator = A_LES) or (_operator = A_LDS)
  173.                     or (_operator = A_SHR) or (_operator = A_SHL)
  174.                     or (_operator = A_SAR) or (_operator = A_SAL)
  175.                     or (_operator = A_OUT) or (_operator = A_IN) then
  176.                     begin
  177.                     end
  178.                     else
  179.                       case s of
  180.                          S_B : hs:='byte '+hs;
  181.                          S_W : hs:='word '+hs;
  182.                          S_L : hs:='dword '+hs;
  183.                          S_S : hs:='dword '+hs;
  184.                          S_Q : hs:='qword '+hs;
  185.                          S_X : if current_module^.output_format in [of_nasm,of_obj] then
  186.                                  hs:='tword '+hs
  187.                                else
  188.                                  hs:='tbyte '+hs;
  189.                          S_BW : if dest then
  190.                              hs:='word '+hs
  191.                            else
  192.                              hs:='byte '+hs;
  193.                          S_BL : if dest then
  194.                              hs:='dword '+hs
  195.                            else
  196.                              hs:='byte '+hs;
  197.                          S_WL : if dest then
  198.                              hs:='dword '+hs
  199.                            else
  200.                              hs:='word '+hs;
  201.                       end
  202.           else
  203.           Begin
  204.             { can possibly give a range check error under tp }
  205.             { if using in...                                 }
  206.             if ((_operator <> A_LGS) and (_operator <> A_LSS) and
  207.                (_operator <> A_LFS) and (_operator <> A_LDS) and
  208.                (_operator <> A_LES)) then
  209.             Begin
  210.             case s of
  211.                S_B : hs:='byte ptr '+hs;
  212.                S_W : hs:='word ptr '+hs;
  213.                S_L : hs:='dword ptr '+hs;
  214.                S_BW : if dest then
  215.                    hs:='word ptr '+hs
  216.                  else
  217.                    hs:='byte ptr '+hs;
  218.                S_BL : if dest then
  219.                    hs:='dword ptr '+hs
  220.                  else
  221.                    hs:='byte ptr '+hs;
  222.                S_WL : if dest then
  223.                    hs:='dword ptr '+hs
  224.                  else
  225.                    hs:='word ptr '+hs;
  226.             end;
  227.             end;
  228.           end;
  229.               getopstr:=hs;
  230.             end;
  231.        top_symbol : begin
  232.              hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  233.              move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  234.              if current_module^.output_format=of_masm then
  235.                hs:='offset '+hs
  236.              else
  237.                hs:='dword '+hs;
  238.  
  239.              if pcsymbol(o)^.offset>0 then
  240.                hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  241.              else if pcsymbol(o)^.offset<0 then
  242.                hs:=hs+tostr(pcsymbol(o)^.offset);
  243.              getopstr:=hs;
  244.           end;
  245.        else internalerror(10001);
  246.     end;
  247.       end;
  248.  
  249.     function getopstr_jmp(t : byte;o : pointer) : string;
  250.  
  251.       var
  252.     hs : string;
  253.  
  254.       begin
  255.     case t of
  256.        top_reg : getopstr_jmp:=int_reg2str[tregister(o)];
  257.        top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
  258.        top_const : getopstr_jmp:=tostr(longint(o));
  259.        top_symbol : begin
  260.              hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  261.